Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / ik0gup.asm < prev next >

Wrap

Assembly Source File | 1992-09-29 | 43.7 KB | 554 lines

GUPI TITLE 'Generic Update Program for IBM 370' 00001000 * 00002000 * (c) 1987, J. F. Chandler 00003000 * 00004000 * Permission is granted to any individual or institution to copy or 00005000 * use this program, except for explicitly commercial purposes. 00006000 * 00007000 * This program consists of two parts: generic (the present file 00008000 * IK0GUP.ASM plus some macros shared with Kermit-370) and system- 00009000 * specific (the file IKxGUP.ASM plus some more shared macros). Here, 00010000 * "x" represents the target system code, such as "T" for TSO. IKxGUP 00011000 * is composed of "COPY" elements (designed to be fetched from a macro 00012000 * library) plus, perhaps, some specialized GUPI macros. The simplest 00013000 * method of assembling this program is to make a macro library out of 00014000 * IKxGUP or to include its members in the Kermit-370 library, if any. 00015000 * Like the corresponding Kermit files IKxMAC.ASM, the specific part of 00016000 * GUPI is divided into members by lines beginning "*COPY" and 00017000 * containing the member name in columns 55-62. If the Kermit-370 00018000 * macros are not kept in a library, the ones needed by GUPI can be 00019000 * inserted by hand before the first EJECT. 00020000 * 00021000 * Kermit macros used in the generic code: 00022000 * CLOSF, DMSFREE, DMSFRET, ENTER, EXIT, FDBD, FDBPAT, KCALL, @SC90047 00023290 * KMAIN, @SC90047 00023580 * LOCALS, LREG, OPENF, PTEXT, READF, RET, WRITF, WTEXT @SC88111 00024000 * 00025000 * 1. System-specific code is responsible for the interface between the 00026000 * program on the one hand and the user and operating system on the 00027000 * other. The user interface consists of supplying the following 00028000 * information: 00029000 * SRCNAM - file spec of the base source 00030000 * CTLNAM - file spec of the update controls 00031000 * OUTNAM - file spec of the output new source 00032000 * MRKD - 3-character sequence label to be placed in columns 00033000 * 73-75 of inserted or renumbered records in 5-column 00034000 * updating mode. 00035000 * FLG - byte of flags governing the options of in-core vs. 00036000 * disk-to-disk updates and 5- vs. 8-column mode. 00037000 * The system-specific code must also include subroutine DISKIO and 00038000 * any other system-interface routines for error message, memory 00039000 * management, and the like. 00040000 * 00041000 * 2. Generic code carries out the update function, reading the source 00042000 * and control files and writing the updated output. In disk-to-disk 00043000 * mode, GUPI makes a single pass (reading and writing in parallel 00044000 * with minimal buffering), and the control commands must form a 00045000 * non-overlapping monotonic sequence, but in-core update mode allows 00046000 * any number of sub-sequences to be applied cumulatively by making 00047000 * three passes: (1) read the entire source, (2) apply updates, and 00048000 * (3) write out the new source. 00049000 * 00050000 * The update control file consists of control cards and data cards. 00051000 * All control cards begin with './' in columns 1-2 followed by 00052000 * free-form fields in columns 4-50, and all other cards are 00053000 * considered data cards. In the following, parentheses denote 00054000 * optional items, upper-case items are verbatim, and lower-case 00055000 * items are 'variables' to be filled in. 00056000 * 00057000 * Comment: ./ * remarks 00058000 * Annotates the update file. No other function. 00059000 * 00060000 * Sequence: ./ S seq1 inc (mark) 00061000 * Resequences the entire source file. The output starts with 00062000 * number 'seq1' and steps by 'inc'. If a 'mark' is supplied, it 00063000 * replaces the default contents of columns 73-75. 00064000 * 00065000 * Delete: ./ D line1 (line2) 00066000 * Removes source line 'line1' or lines 'line1' through 'line2' 00067000 * inclusive. The starting and ending line numbers must exist 00068000 * in the source file. 00069000 * 00070000 * Insert: ./ I line1 ($ seq1 inc) 00071000 * Inserts the immediately following data cards after line 00072000 * 'line1' (which must exist) in the source. The inserted cards 00073000 * are resequenced from 'seq1' by 'inc' and must fit strictly 00074000 * between line 'line1' and its successor. 00075000 * 00076000 * Replace: ./ R line1 (line2) ($ seq1 inc) 00077000 * Deletes source lines as in the Delete command and then inserts 00078000 * as in the Insert command except that the new cards are added 00079000 * in place of the deleted range. 00080000 * 00081000 SPACE 4 @SC88111 00081100 * Update history: @SC88111 00081200 * Version 1.1 - 88/8/31 - Implement system-specific epilog, @SC88111 00081300 * allow RECFM=V control file, use new @SC88111 00081400 * FDBPAT macro @SC88111 00081500 * Version 1.2 - 88/12/16- Correct RESEQ bug, more careful seq @SC88351 00081600 * checking @SC88351 00081700 * Version 1.3 - 90/02/16- Correct bug preventing replacement @SC90047 00081800 * of first card, remove ADCON @SC90047 00081900 EJECT 00082000 PRINT NOGEN 00083000 GBLC &STORDS @SC89268 00083300 COPY GUPSPC @SC89268 00083600 * Generic preliminaries 00084000 FDBD 00085000 * 00086000 USING &STORDS,KWRKBASE @SC89268 00087000 USING COMMON,10 00088000 * 00089000 * 00091000 GUPI ENTER MAIN 00092000 COPY GUPNIT 00093000 TITLE 'Update: process control cards' 00094000 OPN DS 0H 00095000 MVC MRK,MRKD Default label field 00096000 LA 3,CTLBUF 00097000 ST 3,INSBP Set up control buffer 00098000 MVC VARS(LVARS),IVARS 00099000 OPENF I,SRCNAM,FDBP,SRC,E=OPNERR 00100000 OPENF I,CTLNAM,FDBP,CTL,E=OPNERR 00101000 OPENF O,OUTNAM,FDBP,OUT,E=OPNERR 00102000 OI FLG,XXTOP Start at top of file 00103000 ZAP LSTNO,=P'0' Clear sequence numbers 00104000 ZAP OUTNO,=P'0' 00105000 SR 6,6 00106000 TM FLG,XXCOR In-core? 00107000 BZ CTLP No, just start reading 00108000 * 00109000 * Read entire file into core 00110000 BAL 9,GBLK 00111000 LA 3,4(1) 00112000 ST 3,INSBP Set up control buffer 00113000 LA 6,SPTR 00114000 RLP BAL 9,GBLK Get buffer 00115000 LA 3,4(1) Start of card 00116000 LR 4,1 Save ptr 00117000 READF SRC,BUFFER=(3),E=RLPZ 00118000 ST 4,0(6) Add to chain 00119000 LR 6,4 00120000 B RLP 00121000 RLPZ C 15,=F'12' Eof? 00122000 BNE DSKERR No, quit 00123000 * 00124000 * Main loop - read a control card 00125000 CTLP L 3,INSBP Ptr to control buffer 00126000 READF CTL,BUFFER=(3),E=CTLZ 00127000 CLC =C'./ ',0(3) Control card? 00128000 BNE ERR0 No, too bad 00129000 CTLQ CH 0,*+10 R0 has length read @SC88244 00130000 BNH *+8 @SC88244 00130200 LA 0,50 Ignore anything after col 50 @SC88244 00130400 AR 0,3 @SC88244 00130600 LA 1,80(,3) End of card buffer @SC88244 00130800 SR 1,0 Length to blank @SC88244 00131000 SR 15,15 @SC88244 00131200 ICM 15,8,=C' ' @SC88244 00131400 MVCL 0,14 @SC88244 00131600 LA 0,2(3) 00132000 ST 0,COL Set up scan 00133000 BAL 14,SCANN Find command 00134000 NOP 0 00135000 MVC CMD,0(3) 00136000 CLI 1(3),C' ' Should be 1 char 00137000 BNE ERR1 No, bad syntax 00138000 CLI CMD,C'*' Comment? 00139000 BE CTLP Yes, ignore it 00140000 LA 1,4 00141000 CMDLP IC 0,CMDTB-1(1) Get next command 00142000 CLM 0,1,CMD Match? 00143000 BE CMDF Ok 00144000 BCT 1,CMDLP 00145000 B ERR1 Bad command 00146000 CMDTB DC C'SDIR' 00147000 CMDF BCT 1,PROC Go if not sequence 00148000 * Resequence source deck 00149000 ZAP INCNO,=P'10' Default increment 00150000 TM FLG,XX8 5-column? 00151000 BZ *+10 Yes 00152000 ZAP INCNO,=P'1000' 8-column default 00153000 MVC NXTNO,INCNO 00154000 MVC MRK,MRKD Default label field 00155000 BAL 14,SCANN Get start value 00156000 B SEQ1 Use defaults 00157000 MVC NXTNO,ARGNO 00158000 BAL 14,SCANN Get increment value 00159000 B SEQ1 Use default 00160000 MVC INCNO,ARGNO 00161000 BAL 14,SCANN Check for label field 00162000 NOP 0 00163000 CLI 0(3),C' ' 00164000 BE SEQ1 00165000 MVC MRK,0(3) Use it 00166000 SEQ1 ZAP ARGNO,=P'0' At start of file? 00167000 BAL 14,SEQCHK 00168000 SEQL BAL 14,NEXT Get a card @SC88351 00169000 LTR 3,3 End? 00170000 BZ CTLP Yes, back to control stream 00171000 BAL 14,SNUM Renumber it 00172000 B SEQL @SC88351 00173000 * 00175000 * Process an editing card 00176000 PROC BAL 14,SCANN Get seqno 1 00177000 B ERR1 Missing 00178000 MVC NXTNO,ARGNO Default start 00179000 LM 0,1,NXTNO 00180000 SRL 1,24 Remove garbage 00181000 LA 2,X'10' Default increment =P'1' 00182000 LA 3,5 Max for checking 00183000 PROCDL SRDL 0,4 Check next digit 00184000 LTR 1,1 Found non-zero? 00185000 BNZ PROCDF Yes, got it 00186000 SLL 2,4 No, try * 10 00187000 BCT 3,PROCDL 00188000 PROCDF ST 2,TMPDW+4 00189000 OI TMPDW+7,15 Fix sign 00190000 ZAP INCNO,TMPDW+4(4) 00191000 BAL 14,INCNXT Default start @SC88351 00192000 BAL 14,SEQCHK Check order 00193000 BAL 14,FIND Get proper source card 00194000 ST 6,SAV6 Save current card ptr 00195000 CLI CMD,C'I' 00196000 BE *+8 No deletion 00197000 OI FLG,XXKIL Delete 00198000 BAL 14,SCANN Get end of range 00199000 B PRC2 Just one card 00200000 BAL 14,FIND Find end of range 00201000 BAL 14,SCANN Should be followed by '$' 00202000 B PRC2 Ok 00203000 B ERR1 Oops, extra number there 00204000 PRC2 BAL 14,NEXT Skip over this card 00205000 BAL 14,KILL Delete, if necessary 00206000 CLI CMD,C'D' 00207000 BE CTLP Done if delete 00208000 BAL 14,SCANN Insert starting number? 00209000 B INSRT No, use defaults 00210000 MVC NXTNO,ARGNO Yes 00211000 CLC OUTNO,NXTNO Is it ok? 00212000 BNL ERR3 Out of sequence 00213000 BAL 14,SCANN Increment? 00214000 B INSRT No, use default 00215000 MVC INCNO,ARGNO 00216000 INSRT L 3,INSBP Ptr to buffer 00217000 INS3 READF CTL,BUFFER=(3),E=CTLZ 00218000 CLC =C'./ ',0(3) 00219000 BE INS5 End of insertion @SC88351 00220000 AR 0,3 @SC88244 00220100 LA 1,72(,3) Must fill to col 72 @SC88244 00220200 SR 1,0 Length to blank, if any @SC88244 00220300 BNP INS3A No need to fill @SC88244 00220400 SR 15,15 @SC88244 00220500 ICM 15,8,=C' ' @SC88244 00220600 MVCL 0,14 Fill with blanks @SC88244 00220700 INS3A DS 0H @SC88244 00220800 BAL 14,SNUM Sequence new card 00221000 TM FLG,XXCOR In-core? 00224000 BZ INS4 No, write it out 00225000 SH 3,EH4 Get chain ptr for buffer 00226000 MVC 0(4,3),0(6) Insert into file 00227000 ST 3,0(6) 00228000 LR 6,3 New card is before 'current' one 00229000 BAL 9,GBLK Get buffer 00230000 EH4 EQU *+2 Offset to card 00231000 LA 3,4(1) 00232000 ST 3,INSBP 00233000 B INS3 00234000 INS4 WRITF OUT,BUFFER=(3),E=DSKERR 00235000 B INS3 00236000 INS5 CLC OUTNO,LSTNO Are we in order? @SC88351 00236200 BNL ERR5 No, give up @SC88351 00236400 B CTLQ @SC88351 00236600 * 00237000 * END OF CONTROL FILE INPUT 00238000 CTLZ CLOSF CTL 00239000 TM FLG,XXCOR In-core? 00240000 BZ RDMP No, copy rest of source to output 00241000 * Write out file and release storage 00242000 LA 6,SPTR Start of file 00243000 DMPLP ICM 6,15,0(6) Get next card 00244000 BZ DMPZ Done 00245000 LA 3,4(6) 00246000 WRITF OUT,BUFFER=(3),E=DSKERR 00247000 B DMPLP 00248000 DMPZ L 6,BPTR Start of blocks 00249000 FRELP LTR 1,6 Reached end of chain? 00250000 BZ FREZ Yes, all released 00251000 ICM 6,15,0(6) Ptr to next 00252000 LA 0,(99*84+4)/8 00253000 DMSFRET DWORDS=(0),LOC=(1) 00254000 B FRELP 00255000 * 00256000 RDMP BAL 14,NEXT Get a card 00257000 LTR 3,3 00258000 BNZ RDMP Keep copying 00259000 * B FREZ 00260000 FREZ CLOSF OUT Close files 00261000 CLOSF SRC 00262000 SR 15,15 Ok 00263000 QUIT DS 0H @SC88111 00264000 COPY GUPFIN @SC88111 00264200 RET MAIN @SC88111 00264400 TITLE 'Update: various subroutines' 00265000 * Renumber a source or inserted record 00266000 SNUM UNPK 72(8,3),NXTNO Replace sequence field 00267000 OI 79(3),C'0' Fix zone 00268000 TM FLG,XX8 Is it 8-col? 00269000 BO *+10 Yes 00270000 MVC 72(3,3),MRK Just 5 00271000 MVC OUTNO,NXTNO Note current number (inserted) @SC88351 00272000 INCNXT AP NXTNO,INCNO @SC88351 00272500 OI NXTNO+4,15 Set uniform sign code @SC88351 00273000 BR 14 00274000 * 00275000 * Check sequence numbers. if out of order, assume new batch 00276000 SEQCHK CP LSTNO,ARGNO Sequence ok? 00277000 BNHR 14 Ok 00278000 TM FLG,XXCOR In-core? 00279000 BZ ERR2 No, can't back up 00280000 OI FLG,XXTOP Yes, start at top 00281000 ZAP LSTNO,=P'0' 00282000 ZAP OUTNO,=P'0' @SC90047 00282500 BR 14 00283000 * 00284000 * Remove deleted cards (if in-core) 00285000 KILL TM FLG,XXKIL 00286000 BZR 14 Not deleting 00287000 NI FLG,255-XXKIL Now turn it off 00288000 TM FLG,XXCOR In-core? 00289000 BZR 14 No, cards were flushed already 00290000 L 1,SAV6 -> start of range 00291000 L 2,0(1) Start 00292000 MVC 0(4,1),0(6) Unchain card(s) 00293000 MVC 0(4,6),FPTR Put on free chain 00294000 ST 2,FPTR 00295000 LR 6,1 Fix current ptr 00296000 BR 14 00297000 * 00298000 * Find desired sequence number 00299000 FIND CLC LSTNO,ARGNO Match? @SC88351 00300000 BER 14 Ok 00301000 BH ERR6 Went too far 00302000 ST 14,FNDSV @SC88111 00302500 BAL 9,NEXTA Get next 00303000 L 14,FNDSV @SC88111 00303500 LTR 3,3 00304000 BZ ERR6 Not found 00305000 B FIND 00306000 * 00307000 * Get next card 00308000 NEXT LR 9,14 Direct return 00309000 NEXTA TM FLG,XXKIL+XXTOP 00310000 BNZ NEXTB Nothing for output 00311000 NEXTOK MVC OUTNO,LSTNO Save output sequence 00316000 NEXTB TM FLG,XXCOR In-core? 00317000 BZ RNEXT No, read it 00318000 TM FLG,XXTOP 00319000 BZ NEXTN 00320000 LA 6,SPTR Start at top 00321000 B NEXTS Rejoin with predecessor of new 00322000 NEXTN ICM 3,15,0(6) Get ptr to current card, if any 00323000 BZR 9 At eof 00324000 LR 6,3 Move to next 00325000 NEXTS ICM 3,15,0(6) Get ptr to new card, if any 00326000 BZ NEXTZ At eof @SC88351 00327000 LA 3,4(3) Ptr to card itself 00328000 NEXTP NI FLG,255-XXINS-XXTOP Started down file 00329000 MVC TMPDW,72(3) Copy sequence field 00330000 TM FLG,XX8 00331000 BO *+10 00332000 MVC TMPDW(3),=C'000' Only 5 digits used 00333000 TRT TMPDW,NUMB Valid? 00334000 BNZR 9 00335000 PACK LSTNO,TMPDW Save value 00336000 BR 9 Return 00337000 * 00338000 RNEXT TM FLG,XXEOF Already hit end? 00339000 BO RNXZ Yes, don't read again 00340000 LA 3,SRCBUF 00341000 TM FLG,XXKIL+XXTOP 00342000 BNZ RNXA No current card, or killing anyway 00343000 WRITF OUT,BUFFER=(3),E=DSKERR 00344000 RNXA READF SRC,BUFFER=(3),E=RNXE 00345000 B NEXTP 00346000 RNXE C 15,=F'12' Eof? 00347000 BNE DSKERR No, quit 00348000 RNXZ SR 3,3 Indicate eof 00349000 OI FLG,XXEOF Remember it 00350000 NEXTZ MVI LSTNO,X'99' Mark infinite sequence number @SC88351 00350500 BR 9 Return 00351000 * 00352000 * Add a block of buffers to free chain, then get one 00353000 GMORE LA 0,(99*84+4)/8 Get 99 at once 00354000 DMSFREE DWORDS=(0),ERR=ERR4 00355000 MVC 0(4,1),BPTR Add to block chain 00356000 ST 1,BPTR 00357000 LA 1,4(1) First new buffer 00358000 LA 0,99 Counter 00359000 GCHN MVC 0(4,1),FPTR Add to chain 00360000 ST 1,FPTR 00361000 LA 1,84(1) 00362000 BCT 0,GCHN 00363000 * Get a free buffer (GBLK) ptr in R1 00364000 GBLK ICM 1,15,FPTR 00365000 BZ GMORE Need to get some more 00366000 MVC FPTR,0(1) 00367000 XC 0(4,1),0(1) Clear chain ptr 00368000 BR 9 AND RETURN 00369000 * 00370000 * Find next numeric field in card, skip if ok 00371000 SCANN SR 1,1 00372000 L 3,COL Current position 00373000 TRT 0(30,3),NBLNK Next non-blank 00374000 BZR 14 Nothing 00375000 LR 3,1 Ptr to field 00376000 TRT 0(10,3),BLNK End of field 00377000 BZR 14 Too long 00378000 ST 1,COL New position 00379000 CLI 0(3),C'0' Numeric? 00380000 BLR 14 No, skip it 00381000 BCTR 1,0 Last char 00382000 SR 1,3 Count - 1 00383000 EX 1,TRTN Check valid digits 00384000 BNZ ERR1 Oops 00385000 EX 1,PCKA 00386000 OI ARGNO+4,15 Fix sign, just in case 00387000 B 4(14) Got it 00388000 PCKA PACK ARGNO,0(,3) 00389000 TRTN TRT 0(,3),NUMB 00390000 TITLE 'Update: error messages' 00391000 ERR0 PTEXT 'MISSING CONTROL CARD' 00392000 B ERPNC 00393000 ERR1 PTEXT 'INVALID CONTROL CARD' 00394000 B ERPRT 00395000 ERR2 PTEXT 'CONTROL CARD OUT OF ORDER, DISK-TO-DISK MODE' 00396000 B ERPNC 00397000 ERR3 MVC LSTNO,NXTNO Get bad number 00398000 B ERR5 00399000 ERR4 PTEXT 'FREE STORAGE EXHAUSTED, TRY DISK-TO-DISK UPDATE' 00400000 ERRMSG WTEXT (3),(4) Type it 00401000 B ERREX 00402000 ERR5 UNPK MSGS2,LSTNO Set up message 00403000 OI MSGS2+7,C'0' 00404000 UNPK MSGS1,OUTNO 00405000 OI MSGS1+7,C'0' 00406000 PTEXT MSGSQ,LMSGSQ 00407000 B ERPNC 00408000 ERR6 PTEXT 'SEQUENCE NUMBER NOT FOUND' 00409000 B ERPRT 00410000 ERPNC XC COL,COL No column indicator 00411000 ERPRT WTEXT (3),(4) 00412000 L 5,INSBP 00413000 WTEXT (5),80 00414000 ICM 3,15,COL Any column to mark 00415000 BZ ERREX No 00416000 MVI 0(5),C' ' Blank out buffer 00417000 MVC 1(79,5),0(5) 00418000 MVI 0(3),C'*' 00419000 WTEXT (5),80 00420000 ERREX LA 15,20 00421000 B QUIT 00422000 LOCALS 00423000 QUPDT EXIT 00424000 TITLE 'Update: Common code, constants, and variables' 00425000 COMMON CSECT 00426000 * 00427000 * Utility routine to set up linkage 00428000 SUBENT LR KSUBBASE,15 CSECT addressibility @SC89268 00429000 L 15,STKPTR Current end of stack @SC86295 00430000 AR 0,15 Our needs @SC86295 00431000 C 0,STKLIM Does it fit? @SC86295 00432000 BH SUBDIE No, (that's incredible) @SC86295 00433000 ST 0,STKPTR New end @SC86295 00434000 ST 13,4(15) Link subroutines @SC86295 00435000 ST 15,8(13) @SC86295 00436000 L 0,20(13) Restore R0 @SC86295 00437000 LR 13,15 @SC86295 00438000 BR 14 Go @SC86295 00439000 SUBDIE LM 14,12,12(13) @SC86295 00440000 SR 15,15 @SC86295 00441000 BCTR 15,0 Set return code = -1 @SC86295 00442000 BR 14 Go @SC86295 00443000 * 00444000 RTRN2 LA 15,2 Indicate error @SC86295 00445000 B RTRN @SC86295 00446000 RTRN0 SR 15,15 No errors @SC86295 00447000 B RTRN @SC86295 00448000 RTRN1 LA 15,1 Indicate error @SC86295 00449000 RTRN ST 13,STKPTR Free the storage @SC86295 00450000 L 13,4(13) Unlink @SC86295 00451000 L 14,12(13) Restore registers @SC86295 00452000 LM 0,12,20(13) @SC86295 00453000 LTR 15,15 Test return code @SC86295 00454000 BR 14 @SC86295 00455000 * 00456000 * Constants 00457000 NBLNK DC 64X'1',X'0',191X'1' Find non-blank, if any 00458000 BLNK DC 64X'0',X'1',191X'0' Find blank, if any 00459000 NUMB DC 240X'1',10X'0',6X'1' Find non-digit, if any 00460000 TRHEX EQU *-240 00461000 DC C'0123456789ABCDEF' Convert to characters 00462000 F4 DC F'4' 00463000 F8 DC F'8' 00464000 FDBP DS 0F Pattern for file FDB 00466000 DC A(0,80) Buffer ptr, length 00467000 FDBPAT ,F,80 F/80 file @SC88111 00469000 IVARS DS 0D 00470000 IMSGSQ DC C'SEQUENCE ERROR: ' 00471000 DC CL8' ',C' TO ' 00472000 DC CL8' ' 00473000 * Variables 00474000 &STORDS DSECT , @SC89268 00475000 STORAG EQU * @SC89268 00475500 TMPDW DS D For conversions 00476000 STKLO DS A Start of stack space @SC89089 00476300 STKHI DS A High extent of stack usage @SC89089 00476600 STKPTR DS A Save area stack 00477000 STKLIM DS A ditto 00478000 SPTR DS A Ptr to start of file 00479000 FPTR DS A Ptr to free list 00480000 BPTR DS A Allocation block list 00481000 INSBP DS A Ptr to control buffer 00482000 COL DS A Current scan column ptr 00483000 SAV6 DS A Saved card ptr 00484000 FNDSV DS F Return address for FIND @SC88111 00484500 DS 0F 00485000 NXTNO DS PL5 Next sequence number for insert/reseq 00486000 INCNO DS PL5 Sequencing increment 00487000 LSTNO DS PL5 Current sequence number 00488000 OUTNO DS PL5 Last card written 00489000 ARGNO DS PL5 Number read from control card 00490000 CTL DS F Ticket to control input 00492000 SRC DS F Ticket to input source 00493000 OUT DS F Ticket to output file 00494000 CTLBUF DS CL80 Buffers 00495000 SRCBUF DS CL80 00496000 CMD DS C Control command 00497000 MRK DS CL3 Sequence label field 00498000 COPY GUPVAR System-specific variables 00499000 VARS DS 0D 00500000 MSGSQ DC C'SEQUENCE ERROR: ' 00501000 MSGS1 DC CL8' ',C' TO ' 00502000 MSGS2 DC CL8' ' 00503000 LMSGSQ EQU *-MSGSQ 00504000 LVARS EQU *-VARS 00505000 * 00506000 * User interface information 00507000 SRCNAM DS CL(LFID) Input file name 00508000 CTLNAM DS CL(LFID) Control file name 00509000 OUTNAM DS CL(LFID) Output file name 00510000 MRKD DS CL3 Default sequence label field 00511000 FLG DS X Flags 00512000 XXKIL EQU X'80' Deleting source records 00513000 XXTOP EQU X'40' At top of file 00514000 XXINS EQU X'20' Latest card is inserted 00515000 XXEOF EQU X'10' Reached end of source 00516000 XX8 EQU X'02' 8-column sequence field 00517000 XXCOR EQU X'01' Perform update in-core 00518000 DS 0D 00519000 STODWDS EQU (*-STORAG)/8 Length of storage 00520000 COPY GUPSUB 00521000 * 00522000 END GUPI 00523000